home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / File / Find.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  5.9 KB  |  261 lines
  1. package File::Find;
  2. require 5.000;
  3. require Exporter;
  4. use Config;
  5. require Cwd;
  6. require File::Basename;
  7.  
  8.  
  9. =head1 NAME
  10.  
  11. find - traverse a file tree
  12.  
  13. finddepth - traverse a directory structure depth-first
  14.  
  15. =head1 SYNOPSIS
  16.  
  17.     use File::Find;
  18.     find(\&wanted, '/foo','/bar');
  19.     sub wanted { ... }
  20.     
  21.     use File::Find;
  22.     finddepth(\&wanted, '/foo','/bar');
  23.     sub wanted { ... }
  24.  
  25. =head1 DESCRIPTION
  26.  
  27. The wanted() function does whatever verifications you want.
  28. $File::Find::dir contains the current directory name, and $_ the
  29. current filename within that directory.  $File::Find::name contains
  30. C<"$File::Find::dir/$_">.  You are chdir()'d to $File::Find::dir when
  31. the function is called.  The function may set $File::Find::prune to
  32. prune the tree.
  33.  
  34. File::Find assumes that you don't alter the $_ variable.  If you do then
  35. make sure you return it to its original value before exiting your function.
  36.  
  37. This library is primarily for the C<find2perl> tool, which when fed, 
  38.  
  39.     find2perl / -name .nfs\* -mtime +7 \
  40.     -exec rm -f {} \; -o -fstype nfs -prune
  41.  
  42. produces something like:
  43.  
  44.     sub wanted {
  45.         /^\.nfs.*$/ &&
  46.         (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  47.         int(-M _) > 7 &&
  48.         unlink($_)
  49.         ||
  50.         ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  51.         $dev < 0 &&
  52.         ($File::Find::prune = 1);
  53.     }
  54.  
  55. Set the variable $File::Find::dont_use_nlink if you're using AFS,
  56. since AFS cheats.
  57.  
  58. C<finddepth> is just like C<find>, except that it does a depth-first
  59. search.
  60.  
  61. Here's another interesting wanted function.  It will find all symlinks
  62. that don't resolve:
  63.  
  64.     sub wanted {
  65.     -l && !-e && print "bogus link: $File::Find::name\n";
  66.     } 
  67.  
  68. =cut
  69.  
  70. @ISA = qw(Exporter);
  71. @EXPORT = qw(find finddepth);
  72.  
  73.  
  74. sub find {
  75.     my $wanted = shift;
  76.     my $cwd = Cwd::cwd();
  77.     local($topdir,$topdev,$topino,$topmode,$topnlink);
  78.     foreach $topdir (@_) {
  79.     (($topdev,$topino,$topmode,$topnlink) =
  80.       ($Is_VMS ? stat($topdir) : lstat($topdir)))
  81.       || (warn("Can't stat $topdir: $!\n"), next);
  82.     if (-d _) {
  83.         if (chdir($topdir)) {
  84.         ($dir,$_) = ($topdir,'.');
  85.         $name = $topdir;
  86.         $prune = 0;
  87.         &$wanted;
  88.         if (!$prune) {
  89.             my $fixtopdir = $topdir;
  90.                 $fixtopdir =~ s,/$,, ;
  91.             $fixtopdir =~ s/\.dir$// if $Is_VMS;
  92.             $fixtopdir =~ s/\\dir$// if $Is_NT;
  93.             &finddir($wanted,$fixtopdir,$topnlink);
  94.         }
  95.         }
  96.         else {
  97.         warn "Can't cd to $topdir: $!\n";
  98.         }
  99.     }
  100.     else {
  101.         unless (($_,$dir) = File::Basename::fileparse($topdir)) {
  102.         ($dir,$_) = ('.', $topdir);
  103.         }
  104.         $name = $topdir;
  105.         chdir $dir && &$wanted;
  106.     }
  107.     chdir $cwd;
  108.     }
  109. }
  110.  
  111. sub finddir {
  112.     my($wanted, $nlink);
  113.     local($dir, $name);
  114.     ($wanted, $dir, $nlink) = @_;
  115.  
  116.     my($dev, $ino, $mode, $subcount);
  117.  
  118.     opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
  119.     my(@filenames) = readdir(DIR);
  120.     closedir(DIR);
  121.  
  122.     if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
  123.     for (@filenames) {
  124.         next if $_ eq '.';
  125.         next if $_ eq '..';
  126.         $name = "$dir/$_";
  127.         $nlink = 0;
  128.         &$wanted;
  129.     }
  130.     }
  131.     else {                    # This dir has subdirectories.
  132.     $subcount = $nlink - 2;
  133.     for (@filenames) {
  134.         next if $_ eq '.';
  135.         next if $_ eq '..';
  136.         $nlink = $prune = 0;
  137.         $name = "$dir/$_";
  138.         &$wanted;
  139.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  140.  
  141.  
  142.         ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
  143.         
  144.         if (-d _) {
  145.  
  146.  
  147.             if (!$prune && chdir $_) {
  148.             $name =~ s/\.dir$// if $Is_VMS;
  149.             $name =~ s/\\dir$// if $Is_NT;
  150.             &finddir($wanted,$name,$nlink);
  151.             chdir '..';
  152.             }
  153.             --$subcount;
  154.         }
  155.         }
  156.     }
  157.     }
  158. }
  159.  
  160.  
  161. sub finddepth {
  162.     my $wanted = shift;
  163.  
  164.     $cwd = Cwd::fastcwd();;
  165.  
  166.     local($topdir, $topdev, $topino, $topmode, $topnlink);
  167.     foreach $topdir (@_) {
  168.     (($topdev,$topino,$topmode,$topnlink) =
  169.       ($Is_VMS ? stat($topdir) : lstat($topdir)))
  170.       || (warn("Can't stat $topdir: $!\n"), next);
  171.     if (-d _) {
  172.         if (chdir($topdir)) {
  173.         my $fixtopdir = $topdir;
  174.         $fixtopdir =~ s,/$,, ;
  175.         $fixtopdir =~ s/\.dir$// if $Is_VMS;
  176.         $fixtopdir =~ s/\\dir$// if $Is_NT;
  177.         &finddepthdir($wanted,$fixtopdir,$topnlink);
  178.         ($dir,$_) = ($fixtopdir,'.');
  179.         $name = $fixtopdir;
  180.         &$wanted;
  181.         }
  182.         else {
  183.         warn "Can't cd to $topdir: $!\n";
  184.         }
  185.     }
  186.     else {
  187.         unless (($_,$dir) = File::Basename::fileparse($topdir)) {
  188.         ($dir,$_) = ('.', $topdir);
  189.         }
  190.         $name = $topdir;
  191.         chdir $dir && &$wanted;
  192.     }
  193.     chdir $cwd;
  194.     }
  195. }
  196.  
  197. sub finddepthdir {
  198.     my($wanted, $nlink);
  199.     local($dir, $name);
  200.     ($wanted,$dir,$nlink) = @_;
  201.     my($dev, $ino, $mode, $subcount);
  202.  
  203.     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
  204.     my(@filenames) = readdir(DIR);
  205.     closedir(DIR);
  206.  
  207.     if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
  208.     for (@filenames) {
  209.         next if $_ eq '.';
  210.         next if $_ eq '..';
  211.         $name = "$dir/$_";
  212.         $nlink = 0;
  213.         &$wanted;
  214.     }
  215.     }
  216.     else {                    # This dir has subdirectories.
  217.     $subcount = $nlink - 2;
  218.     for (@filenames) {
  219.         next if $_ eq '.';
  220.         next if $_ eq '..';
  221.         $nlink = 0;
  222.         $name = "$dir/$_";
  223.         if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
  224.  
  225.  
  226.         ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
  227.         
  228.         if (-d _) {
  229.  
  230.  
  231.             if (chdir $_) {
  232.             $name =~ s/\.dir$// if $Is_VMS;
  233.             $name =~ s/\\dir$// if $Is_NT;
  234.             &finddepthdir($wanted,$name,$nlink);
  235.             chdir '..';
  236.             }
  237.             --$subcount;
  238.         }
  239.         }
  240.         &$wanted;
  241.     }
  242.     }
  243. }
  244.  
  245. $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
  246.  
  247. if ($^O eq 'VMS') {
  248.   $Is_VMS = 1;
  249.   $dont_use_nlink = 1;
  250. }
  251. if ($^O =~ m:^mswin32:i) {
  252.   $Is_NT = 1;
  253.   $dont_use_nlink = 1;
  254. }
  255.  
  256. $dont_use_nlink = 1
  257.     if $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos';
  258.  
  259. 1;
  260.  
  261.